Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue31/tablesrc/TABLESRC.PAS

Pascal/Delphi Source File | 1996-10-05 | 5.5 KB | 198 lines

unit TableSrc;
interface
uses
  WinTypes, WinProcs, SysUtils, Classes, Dialogs, Forms,
  ExptIntf, VirtIntf, DB, DBTables;

Type
  TTableSrcExpert = class(TIExpert)
  public
    { Expert Style }
    function GetStyle: TExpertStyle; override;
    { Expert Strings }
    function GetIDString: String; override;
    function GetName: String; override;
  {$IFDEF WIN32}
    function GetAuthor: String; override;
  {$ENDIF}
    function GetMenuText: String; override;
    function GetState: TExpertState; override;
    { Launch the Expert }
    procedure Execute; override;
  end {TDataSrcExpert};

implementation
uses TypInfo;

  procedure HandleException;
  begin
    if Assigned(ToolServices) then
      ToolServices.RaiseException(ReleaseException)
  end {HandleException};


  function TTableSrcExpert.GetStyle: TExpertStyle;
  begin
    try
      Result := esStandard
    except
      HandleException
    end
  end {GetStyle};

  function TTableSrcExpert.GetIDString: String;
  begin
    try
      Result := 'DrBob.TableSrcExpert'
    except
      HandleException
    end
  end {GetIDString};

  function TTableSrcExpert.GetName: String;
  begin
    try
      Result := 'Table Source Expert';
    except
      HandleException
    end
  end {GetName};

{$IFDEF WIN32}
  function TTableSrcExpert.GetAuthor: String;
  begin
    try
      Result := 'Dr.Bob'
    except
      HandleException
    end
  end {GetAuthor};
{$ENDIF}

  function TTableSrcExpert.GetMenuText: String;
  begin
    try
      Result := '&Table Source Expert...'
    except
      HandleException
    end
  end {GetMenuText};

  function TTableSrcExpert.GetState: TExpertState;
  begin
    try
      Result := [esEnabled]
    except
      HandleException
    end
  end {GetState};



  procedure TTableSrcExpert.Execute;
  var f: System.Text;
      i: Integer;

      function OptionNames(IndexOptions: TIndexOptions): String;
      begin
        Result := '[ ';
        if ixPrimary in IndexOptions then
          Result := Result + 'ixPrimary,';
        if ixUnique in IndexOptions then
          Result := Result + 'ixUnique,';
        if ixDescending in IndexOptions then
          Result := Result + 'ixDescending,';
      { if ixNonMaintained in IndexOptions then
          Result := Result + 'ixNonMaintained,'; }
        if ixCaseInsensitive in IndexOptions then
          Result := Result + 'ixCaseInsensitive,';
        Delete(Result,Length(Result),1); { laatste weg }
        Result := Result + ']'
      end {OptionNames};

  begin
    try
    { if (ToolServices = nil) then
        raise Exception.Create('ToolServices not available!')
      else }
      with TTable.Create(nil) do
      try
        with TOpenDialog.Create(nil) do
        try
          Title := GetName; { name of Expert as OpenDialog caption }
          Filter := 'DB Files (*.db)|*.db';
          Options := Options + [ofShowHelp, ofPathMustExist, ofFileMustExist];
          if Execute then { not a showmodal! }
          begin
            DatabaseName := ExtractFilePath(FileName);
            TableName := ExtractFileName(FileName)
          end
        finally
          Free
        end;

        {generate the first part of the unit source}
        System.Assign(f,ChangeFileExt(TableName,'.PAS'));
        System.Rewrite(f);
        writeln(f,'unit ',ChangeFileExt(TableName,''),';');
        writeln(f,'interface');
        writeln(f);
        writeln(f,'  procedure Create',ChangeFileExt(TableName,''),';');
        writeln(f);
        writeln(f,'implementation');
        writeln(f,'uses DB, DBTables;');
        writeln(f);
        writeln(f,'  procedure Create',ChangeFileExt(TableName,''),';');
        writeln(f,'  begin');
        writeln(f,'    with TTable.Create(nil) do');
        writeln(f,'    try');
        writeln(f,'      Active := False;');
        writeln(f,'      TableType := ttParadox;');
        writeln(f,'      TableName := ''',TableName,''';');

        FieldDefs.Update { get info without opening the database };
        writeln(f,'      with FieldDefs do');
        writeln(f,'      begin');
        writeln(f,'        Clear;');
        for i:=0 to Pred(FieldDefs.Count) do
        begin
          writeln(f,' ':8,'Add(''',FieldDefs[i].Name,''', ',
          {$IFDEF Win32}
            GetEnumName(TypeInfo(TFieldType),  Ord(FieldDefs[i].DataType)),
          {$ELSE}
            GetEnumName(TypeInfo(TFieldType),  Ord(FieldDefs[i].DataType))^,
          {$ENDIF}
            ', ',FieldDefs[i].Size,', ',
            FieldDefs[i].Required,');')
        end;
        writeln(f,'      end;');

        IndexDefs.Update { get info without opening the database };
        writeln(f,'      with IndexDefs do');
        writeln(f,'      begin');
        writeln(f,'        Clear;');
        for i:=0 to Pred(IndexDefs.Count) do
        begin
          writeln(f,' ':8,'Add(''',IndexDefs[i].Name,''', ''',
                                   IndexDefs[i].Fields,''', ',
                                   OptionNames(IndexDefs[i].Options),');')
        end;
        writeln(f,'      end;');

        writeln(f,'      CreateTable');
        writeln(f,'    finally');
        writeln(f,'      Free');
        writeln(f,'    end');
        writeln(f,'  end {Create',ChangeFileExt(TableName,''),'};');
        writeln(f);
        writeln(f,'end.');
        System.Close(f)
      finally
        Free
      end
    except
      HandleException
    end
  end {Execute};
end.